{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit ColourRenderer;

interface

uses AHMTypes, Graphics, Canvas, Colour;

const
  // Maximum plasma dimensions without blowing up stack
  MAX_PLASMA_SIZE = 1024;
  PLASMA_NOISE = 0.5; // Smoothness of Plamsa effect. Lower values = smoother

type
  TAHMColourRenderer = class
  private
  protected
  public
    procedure BlendBitmap(TLColour, TRColour, BLColour, BRColour: TAHMCanvasColour; Buffer: TBitmap);
    procedure PlasmaBitmap(Buffer: TAHMDrawBuffer; PlasmaDensity: Byte);
  end;

var
  ColourRendererInstance: TAHMColourRenderer;

implementation

uses SysUtils, Graphic, Logging, Screen;

procedure TAHMColourRenderer.BlendBitmap(TLColour, TRColour, BLColour, BRColour: TAHMCanvasColour; Buffer: TBitmap);
type
  // Colour adjustment uses scaled integers (*256) rather than floating point
  // values for speed - approx. twice as fast as using floats, with no perceptible
  // visual difference.
  TColourAdjust = array[TColourType] of Word;
var
  iX, iY, iWidth, iHeight: Integer;
  caY1, caY2, caX, caL, caR, caH: TColourAdjust;
  ct: TColourType;
  ScanLine32: PPixelArray;
begin
  // Get properties of passed buffer
  iWidth := Buffer.Width;
  iHeight := Buffer.Height;

  // Can't be done if width or height is zero
  if (iWidth = 0) or (iHeight = 0) then
  begin
    LogWarn('Received request to generate graduated fill of zero dimensions');
    Exit;
  end;

  // Calculate colour change down left and right sides and init start colour
  for ct := ctBlue to ctAlpha do
  begin
    caL[ct] := Round((BLColour.Pixel[ct] - TLColour.Pixel[ct]) * 256 / iHeight);
    caR[ct] := Round((BRColour.Pixel[ct] - TRColour.Pixel[ct]) * 256 / iHeight);
    caY1[ct] := TLColour.Pixel[ct] * 256;
    caY2[ct] := TRColour.Pixel[ct] * 256;
  end;

  // Ensure bitmap is 32 bit device independent format
  Buffer.HandleType := bmDIB;
  Buffer.PixelFormat := pf32Bit;

  // Iterate through each row of buffer
  for iY := 0 to Pred(iHeight) do
  begin
    for ct := ctBlue to ctAlpha do
    begin
      // Calculate horizontal colour change for current row
      caH[ct] := Round((caY2[ct] - caY1[ct]) / iWidth);
      caX[ct] := caY1[ct];
      // Calculate colour of next row start & finish pixels
      caY1[ct] := caY1[ct] + caL[ct];
      caY2[ct] := caY2[ct] + caR[ct];
    end;

    // Get the bitmap scanline storage for current row
    Scanline32 := Buffer.ScanLine[iY];

    // Compute each pixel along current row
    for iX := 0 to Pred(iWidth) do
    begin
      // Write directly into scanline memory for speed. This uses 32
      // bit format and taking high byte performs fast division by 256
      ScanLine32[iX,ctAlpha] := Hi(caX[ctAlpha]);
      ScanLine32[iX,ctRed] := Hi(caX[ctRed]);
      ScanLine32[iX,ctGreen] := Hi(caX[ctGreen]);
      ScanLine32[iX,ctBlue] := Hi(caX[ctBlue]);

      // Update colours for next pixel
      caX[ctAlpha] := caX[ctAlpha] + caH[ctAlpha];
      caX[ctRed] := caX[ctRed] + caH[ctRed];
      caX[ctGreen] := caX[ctGreen] + caH[ctGreen];
      caX[ctBlue] := caX[ctBlue] + caH[ctBlue];
    end;
  end;
end;

procedure TAHMColourRenderer.PlasmaBitmap(Buffer: TAHMDrawBuffer; PlasmaDensity: Byte);
type
  TPlasmaBuffer = array[0..MAX_PLASMA_SIZE - 1, 0..MAX_PLASMA_SIZE - 1] of Byte;
  PPlasmaBuffer = ^TPlasmaBuffer;
var
  Plasma: PPlasmaBuffer;
  iX, iY, iWidth, iHeight: Integer;
  Lock: TAHMBitmapData;
  BytePointer: TAHMBytePointer;
  ScanLine: PPixelArray;

  // Recursive Plasma fractal generator
  procedure Halfway(const x1, y1, x2, y2: Integer);
    procedure Adjust(const xa, ya, x, y, xb, yb: Integer);
    var
      Dist, Value: Integer;
    begin
     // Only process each plasma pixel once
     if Plasma[x,y] <> 0 then Exit;

     // Approximate distance of bounding points
     Dist := Abs(xa - xb) + Abs(ya - yb);

     // Average pixel colour from bounding points + weighted random factor
     Value := Trunc((Plasma[xa,ya] + Plasma[xb,yb]) / 2 + (Random-0.5) * Dist * PLASMA_NOISE);

     // Clamp max/min pixel colours
     if Value < 1 then Value := 1;
     if Value > PlasmaDensity then Value := PlasmaDensity;
     Plasma[x,y] := Value;
    end;
  var
    x,y: integer;
  begin
    // Don't compute single pixels
    if (x2 - x1 < 2) and (y2 - y1 < 2) then Exit;

    // Calculate mid point coordinates for bounding rectangle
    x := (x1 + x2) div 2;
    y := (y1 + y2) div 2;

    // Apply weighted smoothing from four corners of bounding rectangle
    Adjust(x1, y1, x, y1, x2, y1);
    Adjust(x2, y1, x2, y, x2, y2);
    Adjust(x1, y2, x, y2, x2, y2);
    Adjust(x1, y1, x1, y, x1, y2);

    // Final pixel value is average of four bounding pixels
    if Plasma[x,y] = 0 then
      Plasma[x,y] := (Plasma[x1,y1] + Plasma[x2,y1] + Plasma[x2,y2] + Plasma[x1,y2]) div 4;

    // Recursively apply to four quarters of bounding rectangle
    Halfway(x1, y1, x, y);
    Halfway(x, y1, x2, y);
    Halfway(x, y, x2, y2);
    Halfway(x1, y, x, y2);
  end;

begin
  // Get properties of passed buffer
  iWidth := Buffer.Width;
  iHeight := Buffer.Height;

  // Can't be done if width or height is zero or exceeds max plasma size
  if (iWidth = 0) or (iHeight = 0) then
    LogWarn('Received request to generate plasma cloud fill of zero dimensions')
  else if (iWidth > MAX_PLASMA_SIZE) or (iHeight > MAX_PLASMA_SIZE) then
    LogWarn('Requested plasma size exceeds maximum permitted plasma dimensions')
  else
    try
      // Allocate plasma storage on demand - big array!
      New(Plasma);
      try
        // Initialise four corners of plasma field
        Plasma[0, iHeight - 1] := Random(PlasmaDensity);
        Plasma[iWidth - 1, iHeight - 1] := Random(PlasmaDensity);
        Plasma[iWidth - 1, 0] := Random(PlasmaDensity);
        Plasma[0, 0] := Random(PlasmaDensity);

        // Create plasma field using recursive fractal
        Halfway(0, 0, iWidth - 1, iHeight - 1);

        // Lock the drawbuffer
        Lock.LockMode := lmWrite;
        if Buffer.LockBitmap(Buffer.BufferRect, Lock) then
          try
            // Get pointer to first row of drawbuffer memory
            BytePointer := Lock.PixelData;

            // Iterate through each row of buffer
            for iY := 0 to Pred(iHeight) do
            begin
              // Get the bitmap scanline storage for current row & calc next row
              Scanline := Lock.PixelData;
              Inc(BytePointer, Lock.RowDelta);
              Lock.PixelData := BytePointer;

              // Compute each pixel along current row
              for iX := 0 to Pred(iWidth) do
              begin
                // Build A8R8G8B8 pixel structure (g & b components ignored)
                ScanLine[iX,ctAlpha] := Plasma[iX, iY];
                ScanLine[iX,ctRed]   := $FF;
              end;
            end;
          finally
            Buffer.UnlockBitmap;
          end;
      finally
        Dispose(Plasma);
      end;
    except
      on E:Exception do
        LogWarn('Error encountered whilst generating plasma cloud: ' + E.Message);
    end;
end;


initialization
  ColourRendererInstance := TAHMColourRenderer.Create;

finalization
  ColourRendererInstance.Free;

end.
